Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Peter Lewis/PNL Libraries/MyOOAboutHelp.p

Text File | 1994-09-21 | 7.4 KB | 358 lines | [TEXT/PJMM]

unit MyOOAboutHelp;

interface

    uses
        MyOOMainLoop;

    const
        agwtAbout = '•About';
        agwtHelp = '•Help';

    type
        AboutStringsObject = object
                function GetString (index: integer): str255;
            end;

    var
        about_click_count: longInt;

    procedure InitAboutHelp (obj: AboutStringsObject);
    procedure UpdateAboutBox;
    procedure OpenAboutBox;
    procedure CloseAboutBox;
    procedure ExternalAboutHelp (var x: ptr; id: integer);
    procedure ExternalSetMenu (themenu, theitem: integer; x: ptr);

implementation

    uses
        MyMenus, MyDialogs, MyStrings, MyVersionResource, MySystemGlobals, IconFamilies,{}
        MyFMenus, AERegistry, MyAEUtils, AEObjects, MyStrh, MyUtils, MyTypes, BaseGlobals;

    const
        text_item = 3;
        about_dialog_ID = 128;
        help_dialog_ID = 129;
        about_strh_id = 928;
        kAEHelp = 'help';

    type
        BaseObject = object(DObject)
                global_object: ^WObject;
                procedure Create (id: integer);
                override;
                procedure Destroy;
                override;
            end;

    type
        VerObject = object(BaseObject)
                text, styles: handle;
                procedure Create (id: integer);
                override;
                procedure Destroy;
                override;
                procedure DrawTextData;
            end;
        AboutObject = object(BaseObject)
                procedure DoItem (item: integer);
                override;
            end;

    var
        about_object: BaseObject;
        help_object: VerObject;
        old_about: boolean;
        strings: AboutStringsObject;

    procedure AboutObject.DoItem (item: integer);
        var
            r: rect;
    begin
        about_click_count := about_click_count + 1;
        GetDItemRect(window, item, r);
        SetPort(window);
        InvalRect(r);
    end;

    function AboutStringsObject.GetString (index: integer): str255;
        var
            vers: versionRecord;
    begin
        GetVersion(vers);
        case index of
            0:
                GetString := vers.long;
            1:
                GetString := vers.short;
            2:
                GetString := vers.name;
            otherwise
                GetString := '???';
        end;
    end;

    procedure DrawTextItem (dlg: dialogPtr; item: integer);
    begin
        VerObject(GetWObject(dlg)).DrawTextData;
    end;

    procedure BaseObject.Destroy;
    begin
        global_object^ := nil;
        inherited Destroy;
    end;

    procedure VerObject.DrawTextData;
        var
            te: TEHandle;
            r: rect;
    begin
        GetDItemRect(window, text_item, r);

        te := TEStylNew(r, r);
        HLock(text);
        TEStylInsert(text^, GetHandleSize(text), StScrpHandle(styles), te);
        HUnlock(text);

        TEUpdate(r, te);
        TEDispose(te);
    end;

    procedure BaseObject.Create (id: integer);
        var
            s: str255;
            vers: versionRecord;
    begin
        inherited Create(id);
        GetWTitle(window, s);
        GetVersion(vers);
        SPrintS3(s, s, vers.name, '', '');
        SetWTitle(window, s);
    end;

    procedure VerObject.Create (id: integer);
        var
            k: integer;
            h: handle;
            r: rect;
            te: TEHandle;
            add: integer;
    begin
        text := nil;
        styles := nil;
        UseResFile(app_resfile);
        SetVersionParamText('');
        inherited Create(id);
        SetPort(window);
        TextFont(geneva);
        GetDItem(window, text_item, k, h, r);
        if BAND(k, $7F) = userItem then begin
            text := GetResource('TEXT', id);
            if text <> nil then begin
                HNoPurge(text);
                styles := GetResource('styl', id);
                HNoPurge(styles);

                te := TEStylNew(r, r);
                HLock(text);
                TEStylInsert(text^, GetHandleSize(text), StScrpHandle(styles), te);
                HUnlock(text);
                HPurge(text);
                HPurge(styles);

                add := r.top - r.bottom + TEGetHeight(0, te^^.nLines, te);
                TEDispose(te);
                r.bottom := r.bottom + add;
                SetDItem(window, text_item, k, HANDLE(@DrawTextItem), r);
                r := window^.portRect;
                SizeWindow(window, r.right - r.left, r.bottom - r.top + add, false);
            end;
        end;
    end;

    procedure VerObject.Destroy;
    begin
        if text <> nil then
            ReleaseResource(text);
        if styles <> nil then
            ReleaseResource(styles);
        inherited Destroy;
    end;

    procedure DoAboutHelp (var obj: VerObject; id: integer);
    begin
        if obj <> nil then begin
            if FrontWindow <> obj.window then begin
                SelectWindow(obj.window);
            end;
        end
        else begin
            new(obj);
            obj.global_object := @obj;
            obj.Create(id);
            ShowWindow(obj.window);
        end;
    end;

    procedure ExternalAboutHelp (var x: ptr; id: integer);
    begin
        DoAboutHelp(VerObject(x), id);
    end;

    procedure DoHelp;
    begin
        DoAboutHelp(help_object, help_dialog_id);
        help_object.AppleGuideWindowType := agwtHelp;
    end;

    procedure AboutDisplayStyledString (dlg: dialogPtr; item: integer);
        var
            s, t: str255;
            i: integer;
    begin
        GetIndString(s, about_strh_id, item);
        i := 1;
        while (i < length(s)) do begin
            if s[i] = '^' then begin
                t := strings.GetString(ord(s[i + 1]) - ord('0'));
                Delete(s, i, 2);
                Insert(t, s, i);
                i := i + length(t);
            end
            else begin
                i := i + 1;
            end;
        end;
        DisplayStyledString(dlg, item, s);
    end;

    procedure DrawAboutIcon (dlg: DialogPtr; item: integer);
        var
            r: rect;
            junk: OSErr;
    begin
        GetDItemRect(dlg, item, r);
        junk := PlotIconID(r, atNone, ttNone, 128);
    end;

    procedure DoAbout;
        var
            i, k: integer;
    begin
        about_click_count := about_click_count + 1;
        if old_about | (about_object <> nil) then begin
            DoAboutHelp(VerObject(about_object), about_dialog_id);
        end
        else begin
            new(AboutObject(about_object));
            about_object.global_object := @about_object;
            about_object.Create(about_dialog_id);
            GetDItemKind(about_object.window, 1, k);
            if k = $80 then begin
                SetDItemHandle(about_object.window, 1, handle(@DrawAboutIcon));
            end;
            for i := 2 to 30 do begin
                if GetIndStr(about_strh_id, i) <> '' then begin
                    SetDItemHandle(about_object.window, i, @AboutDisplayStyledString);
                end;
            end;
            ShowWindow(about_object.window);
        end;
        about_object.AppleGuideWindowType := agwtAbout;
    end;

    procedure DoAboutMenu;
    begin
        if has_AppleEvents then begin
            SendSelfSimpleEvent(kAECoreSuite, kAEAbout);
        end
        else begin
            DoAbout;
        end;
    end;

    procedure DoHelpMenu;
    begin
        if has_AppleEvents then begin
            SendSelfSimpleEvent(kAECoreSuite, kAEHelp);
        end
        else begin
            DoHelp;
        end;
    end;

    procedure SetAboutMenu (themenu, theitem: integer);
    begin
        SetIDItemEnable(themenu, theitem, not ISWObjectFront(about_object));
    end;

    procedure SetHelpMenu (themenu, theitem: integer);
    begin
        SetIDItemEnable(themenu, theitem, not ISWObjectFront(help_object));
    end;

    procedure ExternalSetMenu (themenu, theitem: integer; x: ptr);
    begin
        SetIDItemEnable(themenu, theitem, not ISWObjectFront(DObject(x)));
    end;

    function HandleAbout (event, reply: AppleEvent; refcon: longInt): OSErr;
    begin
        DoAbout;
        HandleAbout := noErr;
    end;

    function HandleHelp (event, reply: AppleEvent; refcon: longInt): OSErr;
    begin
        DoHelp;
        HandleHelp := noErr;
    end;

    procedure UpdateAboutBox;
    begin
        if about_object <> nil then begin
            SetPort(about_object.window);
            InvalRect(about_object.window^.portRect);
        end;
    end;

    procedure CloseAboutBox;
    begin
        if about_object <> nil then begin
            about_object.DoClose;
        end;
    end;

    procedure OpenAboutBox;
    begin
        DoAbout;
        SetPort(about_object.window);
        DrawDialog(about_object.window);
        ValidRect(about_object.window^.portRect);
    end;

{$S Init}
    procedure InitAboutHelp (obj: AboutStringsObject);
        var
            junk: OSErr;
    begin
        about_click_count := 0;
        old_about := obj = nil;
        strings := obj;
        about_object := nil;
        help_object := nil;
        if has_AppleEvents then begin
            junk := AEInstallEventHandler(kAECoreSuite, kAEAbout, @HandleAbout, 0, false);
            if help_menu_text > 0 then begin
                junk := AEInstallEventHandler(kAECoreSuite, kAEHelp, @HandleHelp, 0, false);
            end;
        end;
        SetFBoth(Cabout, @DoAboutMenu, @SetAboutMenu);
        if help_menu_text > 0 then begin
            SetFBoth(Chelp, @DoHelpMenu, @SetHelpMenu);
        end;
    end;

end.